home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / a / a_funk / geograph.tos / GEOGRAPH / QTH_GFA.TXT < prev    next >
Encoding:
Text File  |  1994-01-29  |  9.0 KB  |  365 lines
  1. ' ** Locatorberechnungsprogramm fuer Atari ST mit Monochrommonitor **
  2. Dim M_text$(29)
  3. P=3.14159
  4. K=P/180
  5. Do
  6.   Read M_text$(I%)
  7.   Exit If M_text$(I%)=" Quit "
  8.   Inc I%
  9. Loop
  10. Hidem
  11. Deftext 1,17,0,30
  12. Text 180,40," IARU - Locator"
  13. Deftext 1,0,0,4
  14. Text 120,100,"                August/September '89"
  15. Text 120,109,"             von Manfred Baier - DG8MEQ"
  16. Text 120,118,"mit unentbehrlicher Unterstuetzung von Astrid Baier - DG9MEQ"
  17. Text 120,127,"            Algorithmen:Erich Vogelsang "
  18. Deftext 1,0,0,6
  19. Text 100,200,"Dieses Programm ermittelt den weltweiten Locator aus"
  20. Text 100,220,"oestlicher Laenge und Breite oder umgekehrt,und berech-"
  21. Text 100,240,"net Entfernung und Winkel zu einer beliebigen Gegen-"
  22. Text 100,260,"station auf der Erde."
  23. Text 100,280,"Die Laenge und Breite muss in Grad und Minuten eingegeben"
  24. Text 100,300,"werden (nicht Dezimal).Die Ausgabe erfolgt jedoch Dezi-"
  25. Text 100,320,"mal."
  26. Gosub Mausbox
  27. Gosub Pulldown
  28. Procedure Pulldown
  29.   Cls
  30.   Menu M_text$()
  31.   On Menu  Gosub Berechnung
  32.   Print At(65,1);Time$;"  MEZ"
  33.   Do
  34.     On Menu
  35.   Loop
  36. Return
  37. Procedure Mausbox
  38.   Hidem
  39.   Color 0
  40.   Deffill 1,2,8
  41.   Pbox 230,345,407,370
  42.   Defline 1,1,0,0
  43.   Box 233,348,404,367
  44.   Graphmode 2
  45.   Deftext 0,0,0,6
  46.   Text 240,360,"Weiter mit Maustaste"
  47.   Color 1
  48.   Graphmode 1
  49.   Repeat
  50.   Until Mousek
  51.   Showm
  52. Return
  53. Procedure Berechnung
  54.   Cls
  55.   M_text$=M_text$(Menu(0))
  56.   If M_text$="  Locator         "
  57.     Gosub Locator
  58.   Endif
  59.   If M_text$="  Laenge und Breite  "
  60.     Gosub Laenge_und_breite
  61.   Endif
  62.   If M_text$="  JN57NU            "
  63.     A$="JN57NU"
  64.     Goto Jn57nu
  65.   Endif
  66.   If M_text$="  L 11.8 - B 47.50  "
  67.     L1=11
  68.     L2=8
  69.     B1=47
  70.     B2=50
  71.     Goto Ec
  72.   Endif
  73.   If M_text$="  Locator Info   "
  74.     Gosub Info
  75.   Endif
  76.   If M_text$=" Quit "
  77.     End
  78.   Endif
  79.   If M_text$=" Anleitung "
  80.     Gosub Anleitung
  81.   Endif
  82.   Menu Off
  83. Return
  84. Procedure Info
  85.   Alert 1,"   LOCATOR BERECHNUNG   |   A.und M.Baier 9/89   |    DG9MEQ - DG8MEQ     ",1,"OK",Button%
  86.   Gosub Pulldown
  87. Return
  88. Data Desk,  Locator Info   ,--------------------,1,2,3,4,5,6,""
  89. Data Eingabe,  Locator         ,  Laenge und Breite  ,--------------------,  JN57NU            ,  L 11.8 - B 47.50  ,""
  90. Data Hilfe, Anleitung ,
  91. Data Ende, Quit ,
  92. Procedure Locator
  93.   Print " Eigener Locator                ";
  94.   Input A$
  95.   Jn57nu:
  96.   Gosub Locatoreingabe_pruefen
  97.   Gosub Locator_in_laenge_und_breite
  98.   H$=A$
  99.   V=Y
  100.   V1=Y1
  101.   U=X
  102.   U1=X1
  103.   Cls
  104.   Print At(6,3);"Eigener Locator:      ";H$;"   Laenge:";V1;" Grad  Breite:";U1;" Grad"
  105.   Print At(6,4);"Locator Gegenstation";
  106.   Input A$
  107.   Gosub Locatoreingabe_pruefen
  108.   Gosub Locator_in_laenge_und_breite
  109.   Gosub Entfernung_und_winkel
  110.   Print At(6,4);"-------------------------------------------------------------------"
  111.   Print At(6,5);"Locator:              ";A$;"   Laenge:";Y1;"               ";X1;
  112.   Print At(49,5);"Grad"
  113.   Print At(55,5);"Breite:"
  114.   Print At(68,5);"Grad"
  115.   Print At(6,7);"Entfernung:           ";D2;" km   ";
  116.   Print At(6,8);"Winkel:               ";W2;" Grad"
  117.   Print
  118.   Gosub Mausbox
  119.   Gosub Pulldown
  120. Return
  121. Procedure Laenge_und_breite
  122.   Print At(3,10);"Eigene Laenge        (Grad,Minuten)";
  123.   Input L1,L2
  124.   Gosub Ueberpruefung_der_laengeneingabe
  125.   Print At(3,11);"Eigene Breite       (Grad,Minuten)";
  126.   Input B1,B2
  127.   Gosub Ueberpruefung_der_breiteneingabe
  128.   Ec:
  129.   Gosub Laenge_und_breite_in_standortkenner
  130.   H$=A$
  131.   V=Y
  132.   V1=Y1
  133.   U=X
  134.   U1=X1
  135.   Cls
  136.   Print At(6,3);" Eigener Locator:      ";H$;"   Laenge:";V1;" Grad   Breite:";U1;" Grad"
  137.   Print At(7,4);"-------------------------------------------------------------------"
  138.   Print At(3,10);" Laenge Gegenstation         (Grad,Minuten)";
  139.   Input L1,L2
  140.   Gosub Ueberpruefung_der_laengeneingabe
  141.   Print At(3,11);" Breite Gegenstation        (Grad,Minuten)";
  142.   Input B1,B2
  143.   Gosub Ueberpruefung_der_breiteneingabe
  144.   Gosub Laenge_und_breite_in_standortkenner
  145.   Gosub Entfernung_und_winkel
  146.   Print At(3,10);"                                                     "
  147.   Print At(3,11);"                                                     "
  148.   Print At(7,5);"Locator:              ";A$;"   Laenge:";Y1;"  Grad   Breite:";X1;" Grad"
  149.   Print At(7,7);"Entfernung:           ";D2;" km"
  150.   Print At(7,8);"Winkel:               ";W2;" Grad"
  151.   Gosub Mausbox
  152.   Gosub Pulldown
  153. Return
  154. Procedure Locatoreingabe_pruefen
  155.   If Len(A$)<>6
  156.     Gosub Meldung
  157.   Endif
  158.   B$=Mid$(A$,1,1)
  159.   If B$>="a" And B$<="r"
  160.     B$=Chr$(Asc(B$)-32)
  161.   Endif
  162.   If B$<"A" Or B$>"R"
  163.     Gosub Meldung
  164.   Endif
  165.   C$=Mid$(A$,2,1)
  166.   If C$>="a" And C$<="r"
  167.     C$=Chr$(Asc(C$)-32)
  168.   Endif
  169.   If C$<"A" Or C$>"R"
  170.     Gosub Meldung
  171.   Endif
  172.   D$=Mid$(A$,3,1)
  173.   If D$<"0" Or D$>"9"
  174.     Gosub Meldung
  175.   Endif
  176.   E$=Mid$(A$,4,1)
  177.   If E$<"0" Or E$>"9"
  178.     Gosub Meldung
  179.   Endif
  180.   F$=Mid$(A$,5,1)
  181.   If F$>="a" And F$<="x"
  182.     F$=Chr$(Asc(F$)-32)
  183.   Endif
  184.   If F$<"A" Or F$>"X"
  185.     Gosub Meldung
  186.   Endif
  187.   G$=Mid$(A$,6,1)
  188.   If G$>="a" And G$<="x"
  189.     G$=Chr$(Asc(G$)-32)
  190.   Endif
  191.   If G$<"A" Or G$>"X"
  192.     Gosub Meldung
  193.   Endif
  194.   A$=B$+C$+D$+E$+F$+G$        !Kleinschreibung aendern
  195. Return
  196. Procedure Meldung
  197.   Print Chr$(7)
  198.   Alert 1,"Nur AA00AA - RR99XX moeglich",1,"Nochmal",Button
  199.   Print At(26,4);"        "
  200.   Print At(26,4);"";
  201.   Input A$
  202.   Gosub Locatoreingabe_pruefen
  203. Return
  204. Procedure Ueberpruefung_der_laengeneingabe
  205.   If L1<>Int(L1)
  206.     Gosub Meldungl
  207.   Endif
  208.   If L1<0 Or L1>359
  209.     Gosub Meldungl
  210.   Endif
  211.   If L2<>Int(L2)
  212.     Gosub Meldungl
  213.   Endif
  214.   If L2<0 Or L2>59
  215.     Gosub Meldungl
  216.   Endif
  217. Return
  218. Procedure Meldungl
  219.   Print Chr$(7)
  220.   Alert 1," Laenge nur 0 ... 359, 0 ... 59 moeglich",1,"Nochmal",Button
  221.   Print At(45,10);"                           "
  222.   Print At(45,10);"";
  223.   Input L1,L2
  224.   Gosub Ueberpruefung_der_laengeneingabe
  225. Return
  226. Procedure Ueberpruefung_der_breiteneingabe
  227.   If Sgn(B1)+Sgn(B2)<>0  !Breite mit negativem Vorzeichen
  228.     If B1<>Int(B1)
  229.       Gosub Meldungb
  230.       If B1<>0
  231.         Gosub Meldungb
  232.       Endif
  233.     Endif
  234.   Endif
  235.   If B1<-89 Or B1>89
  236.     Gosub Meldungb
  237.   Endif
  238.   If B2<>Int(B2)
  239.     Gosub Meldungb
  240.   Endif
  241.   If B2<-59 Or B2>59
  242.     Gosub Meldungb
  243.   Endif
  244. Return
  245. Procedure Meldungb
  246.   Print Chr$(7)
  247.   Alert 1," Breite nur 0 ... 89, 0 ... 59| oder 0...-89, 0...-59 moeglich",1,"Nochmal",Button
  248.   Print At(45,11);"                           "
  249.   Print At(45,11);"";
  250.   Input B1,B2
  251.   Gosub Ueberpruefung_der_breiteneingabe
  252. Return
  253. Procedure Locator_in_laenge_und_breite
  254.   If B$<"J"
  255.     B=180+(Asc(B$)-83)*20
  256.   Else
  257.     B=(Asc(B$)-74)*20
  258.   Endif
  259.   C=(Asc(C$)-74)*10
  260.   D=(Asc(D$)-48)*2
  261.   E=Asc(E$)-48
  262.   F=(Asc(F$)-64.5)/12
  263.   G=(Asc(G$)-64.5)/24
  264.   Y=B+D+F
  265.   Y1=Int(100*Y+0.5)/100
  266.   X=C+E+G
  267.   X1=Int(100*X+0.5)/100
  268. Return
  269. Procedure Laenge_und_breite_in_standortkenner
  270.   Y=L1+L2/60
  271.   Y1=Int(100*Y+0.5)/100
  272.   B=Int(L1/20)
  273.   D=Int((L1-20*B)/2)
  274.   F=Int(L2/5)+((L1-20*B)/2-D)*24
  275.   If L1>=180
  276.     B$=Chr$(B+56)
  277.   Else
  278.     B$=Chr$(B+74)
  279.   Endif
  280.   D$=Chr$(D+48)
  281.   F$=Chr$(F+65)
  282.   X=B1+B2/60
  283.   X1=Int(100*X+0.5)/100
  284.   If B2>=0
  285.     C=Int(B1/10)
  286.   Else
  287.     B1=B1-1
  288.     B2=B2+60
  289.   Endif
  290.   C=Int(B1/10)
  291.   E=B1-10*C
  292.   G=Int(B2/2.5)
  293.   C$=Chr$(C+74)
  294.   E$=Chr$(E+48)
  295.   G$=Chr$(G+65)
  296.   A$=B$+C$+D$+E$+F$+G$
  297. Return
  298. Procedure Entfernung_und_winkel
  299.   If A$=H$
  300.     D2=0
  301.     W2=0
  302.   Else
  303.     D0=Sin(K*U)*Sin(K*X)+Cos(K*U)*Cos(K*X)*Cos(K*(Y-V))
  304.     If D0>=1
  305.       D2=0
  306.       W2=0
  307.     Else
  308.       If D0=0
  309.         D1=P/2
  310.       Else
  311.         If D0<=-1
  312.           D1=P
  313.         Else
  314.           D1=Atn(Sqr(1-D0*D0)/D0)
  315.           If D0<=0
  316.             D1=D1+P
  317.           Endif
  318.         Endif
  319.       Endif
  320.     Endif
  321.     D2=Int(6370*D1)
  322.   Endif
  323.   If D0>=1 Or D0<=-1
  324.     W2=0
  325.   Else
  326.     W0=(Sin(K*X)-Sin(K*U)*Cos(D1))/(Cos(K*U)*Sin(D1))
  327.     If W0>=1
  328.       W2=0
  329.     Else
  330.       If W0<=-1
  331.         W1=P
  332.       Else
  333.         W1=P/2-Atn(W0/Sqr(1-W0*W0))
  334.         If Y-V>0 And Y-V<180 Or Y-V<-180
  335.           W2=Int(W1/K)
  336.         Else
  337.           W1=2*P-W1
  338.           W2=Int(W1/K)
  339.         Endif
  340.       Endif
  341.     Endif
  342.   Endif
  343. Return
  344. Procedure Anleitung
  345.   Print
  346.   Print "           Bedienungshinweise fuer das Programm."
  347.   Print "           ------------------------------------"
  348.   Print
  349.   Print "    Die jeweils feststehenden Eingaben 'JN57NU' und 'L 11.8 - B 47.50'"
  350.   Print "    sind die Daten des Autors.Dort koennen die eigenen Daten des Benutzers"
  351.   Print "    eingetragen werden.In den meissten Faellen wird diese Funktion sehr"
  352.   Print "    Sinnvoll sein."
  353.   Print "    Ansonsten erklaert sich das Programm eigentlich von alleine."
  354.   Print "    Das Programm ist gegen die meisten Fehleingaben geschuetzt."
  355.   Print "    Es kann allerdings vorkommen,dass besondere Spezialisten diesen Rahmen"
  356.   Print "    sprengen.Im Zweifelsfall muss das Programm noch einmal gestartet werden!"
  357.   Gosub Mausbox
  358.   Gosub Pulldown
  359. Return
  360. ' Das Programm laeuft in GFA-Basic,Version 2
  361. ' mit Merge in den Interpreter......(kennt ja jeder)
  362. ' Fuer eine Druckerausgabe hatte ich keine Lust mehr.Das kommt vielleicht noch.
  363. ' 73 Astrid und Manfred - DG9MEQ,DG8MEQ - C20
  364.  
  365.